﻿module EmailValidation.EmailValidator

open System
open FParsec
open FParsec.Primitives
open FParsec.CharParsers

let isValidEmail email =
    let wsp = anyOf " \t" >>% ()
    let crlf = pchar '\n' >>% ()
    let nullChar = pchar (char 0) >>% ()
    let ranges = Seq.map (Seq.map char) >> Seq.concat >> Seq.toArray >> (fun x -> String x) >> (fun x -> anyOf x >>% ())
    let vchar = ranges [{0x21..0x7e}]
    let obsNoWsCtl = ranges [{1..8};{11..12};{14..31};{127..127}]
    let atomText = digit <|> letter <|> anyOf "!#$%&'*+-/=?^_`{|}~"
    let atom = many1 atomText >>% ()
    let fws = (many1 wsp >>. optional (crlf >>. many1 wsp)) <|> (many1 (crlf >>. many1 wsp) >>% ())
    let commentText = ranges [{33..39};{42..91};{93..126}] <|> obsNoWsCtl
    let quotedPair = pchar '\\' >>. (vchar <|> wsp <|> crlf <|> obsNoWsCtl <|> nullChar)
    let rec commentContent x = (commentText <|> quotedPair <|> comment) x
    and comment = between (pchar '(') (pchar ')') (many (commentContent <|> fws)) >>% ()
    let cfws = many (comment <|> fws)
    let quotedText = ranges [{33..33};{35..91};{93..126}] <|> obsNoWsCtl
    let quotedContent = quotedText <|> quotedPair
    let quotedString = between (pchar '"') (pchar '"') (many (optional fws >>. quotedContent) >>. optional fws)
    let dottedAtoms = sepBy1 (optional cfws >>. (atom <|> quotedString) >>. optional cfws) (pchar '.') >>% ()
    let localPart = dottedAtoms
    let domainText = ranges [{33..90};{94..126}] <|> obsNoWsCtl
    let domainLiteral =  between (optional cfws >>. pchar '[') (pchar ']' >>. optional cfws) (many (optional fws >>. domainText) >>. optional fws)
    let domain = dottedAtoms <|> domainLiteral 
    let addrSpec = localPart >>. pchar '@' >>. domain >>. eof
    match run addrSpec email with
    | Failure (msg, _, _) -> false
    | Success _ -> true
